home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / dctran.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  19.9 KB  |  665 lines

  1. c spice version 2g.6  sccsid=dctran.ma 3/15/83
  2.       subroutine dctran
  3.       implicit double precision (a-h,o-z)
  4. c
  5. c
  6. c     this routine controls the dc transfer curve, dc operating point,
  7. c and transient analyses.  the variables mode and modedc (defined below)
  8. c determine exactly which analysis is performed.
  9. c
  10. c spice version 2g.6  sccsid=tabinf 3/15/83
  11.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  12.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  13.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  14.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  15.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  16.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  17.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  18.      7   irowno,jcolno,nttbr,nttar,lvntmp
  19. c spice version 2g.6  sccsid=miscel 3/15/83
  20.       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
  21.      1  defas,rstats(50),iwidth,lwidth,nopage
  22. c spice version 2g.6  sccsid=cirdat 3/15/83
  23.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  24.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  25. c spice version 2g.6  sccsid=status 3/15/83
  26.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  27.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  28.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  29. c spice version 2g.6  sccsid=flags 3/15/83
  30.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  31.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  32. c spice version 2g.6  sccsid=dc 3/15/83
  33.       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
  34.      1   kinel,kidin,kovar,kidout
  35. c spice version 2g.6  sccsid=tran 3/15/83
  36.       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
  37. c spice version 2g.6  sccsid=cje 3/15/83
  38.       common /cje/ maxtim,itime,icost
  39. c spice version 2g.6  sccsid=blank 3/15/83
  40.       common /blank/ value(200000)
  41.       integer nodplc(64)
  42.       complex cvalue(32)
  43.       equivalence (value(1),nodplc(1),cvalue(1))
  44.       logical memptr
  45. c
  46. c
  47.       dimension subtit(4,2)
  48.       dimension avhdr(3),avfrm(4)
  49.       data avhdr / 8h( (2x,a4, 8h,3x,a7,3, 5hx)//) /
  50.       data avfrm / 8h( (1h ,a, 8h1,i3,1h), 8h,f10.4,3, 4hx)/) /
  51.       data anode, avltg / 4hnode, 7hvoltage /
  52.       data subtit / 8hsmall si, 8hgnal bia, 8hs soluti, 8hon      ,
  53.      1              8hinitial , 8htransien, 8ht soluti, 8hon      /
  54.       data lprn /1h(/
  55.       data ablnk, aletr, alett /1h , 1hr, 1ht /
  56. c
  57. c      the variables *mode*, *modedc*, and *initf* are used by spice to
  58. c keep track of the state of the analysis.  the values of these flags
  59. c (and the corresponding meanings) are as follows:
  60. c
  61. c        flag    value    meaning
  62. c        ----    -----    -------
  63. c
  64. c        mode      1      dc analysis (subtype defined by *modedc*)
  65. c                  2      transient analysis
  66. c                  3      ac analysis (small signal)
  67. c
  68. c        modedc    1      dc operating point
  69. c                  2      initial operating point for transient analysis
  70. c                  3      dc transfer curve computation
  71. c
  72. c        initf     1      converge with 'off' devices allowed to float
  73. c                  2      initialize junction voltages
  74. c                  3      converge with 'off' devices held 'off'
  75. c                  4      store small-signal parameters away
  76. c                  5      first timepoint in transient analysis
  77. c                  6      prediction step
  78. c
  79. c note:  *modedc* is only significant if *mode* = 1.
  80. c
  81. c
  82. c  initialize
  83. c
  84.       call second(t1)
  85.       sfactr=1.0d0
  86. c.. don't take any chances with lx3, set to large number
  87.       lx3=20000000
  88.       lx2=20000000
  89. c.. see if lx3 and lx2 tables are needed
  90.       nolx2=0
  91.       nolx3=0
  92.    20 loctim=5
  93. c
  94. c.. post-processing initialization
  95. c
  96.       if(ipostp.eq.0) go to 25
  97.       numcur=jelcnt(9)
  98.       numpos=nunods+numcur
  99.       call getm8(ibuff,numpos)
  100.       numpos=numpos*4
  101.       if(numcur.eq.0) go to 25
  102.       loc=locate(9)
  103.       loccur=nodplc(loc+6)-1
  104. c
  105. c...  set up format
  106. c
  107.    25 nvprln=4+(lwidth-72)/19
  108.       nvprln=min0(nvprln,ncnods-1)
  109.       ipos=2
  110.       call alfnum(nvprln,avfrm,ipos)
  111.       ipos=2
  112.       call alfnum(nvprln,avhdr,ipos)
  113. c...  allocate storage
  114.       if (mode.eq.2) go to 35
  115.       need=4*nstop+nttbr+nxtrm
  116.       call avlm8(navl)
  117.       if(need.le.navl) go to 30
  118. c...  not enough memory for dc operating point analysis
  119.       write(iofile,26) need,navl
  120.    26 format('0insufficient memory available for dc analysis.',/
  121.      1' memory required ',i6,', memory available ',i6,'.')
  122.       nogo=1
  123.       go to 1100
  124.    30 call getm8(lvnim1,nstop)
  125.       call getm8(lvn,nstop+nttbr)
  126.       call slpmem(lvn,nstop)
  127.       call getm8(lx0,nxtrm)
  128.       call getm8(lvntmp,nstop)
  129.       if (modedc.ne.3) go to 45
  130.    35 call getm8(lx1,nxtrm)
  131.       if(nolx2.eq.0) call getm8(lx2,nxtrm)
  132.       if (mode.ne.2) go to 40
  133.       if(nolx3.eq.0) call getm8(lx3,nxtrm)
  134.       call getm8(ltd,0)
  135.    40 call getm8(loutpt,0)
  136.    45 call crunch
  137.    50 if (mode.eq.2) go to 500
  138.       time=0.0d0
  139.       ag(1)=0.0d0
  140.       call sorupd
  141.       if (modedc.eq.3) go to 300
  142. c
  143. c
  144. c  ....  single point dc analysis
  145. c
  146. c
  147. c  compute dc operating point
  148. c
  149.   100 if (itl6.gt.0) go to 105
  150.       initf=2
  151.       call iter8(itl1)
  152.       rstats(6)=rstats(6)+iterno
  153.       if (igoof.ne.0) go to 150
  154.       go to 110
  155.   105 call sorstp(itl6)
  156.       rstats(6)=rstats(6)+iterno
  157.       if (igoof.ne.0) go to 150
  158.   110 if (modedc.ne.1) go to 120
  159.       initf=4
  160.       call diode
  161.       call bjt
  162.       call jfet
  163.       call mosfet
  164. c
  165. c  print operating point
  166. c
  167.   120 if ((mode.eq.1).and.(modedc.eq.2).and.(nosolv.ne.0)) go to 1000
  168.       call title(-1,lwidth,1,subtit(1,modedc))
  169.       write (iofile,avhdr) (anode,avltg,i=1,nvprln)
  170.       write (iofile,avfrm) (lprn,nodplc(junode+i),value(lvnim1+i),
  171.      1  i=2,ncnods)
  172.       go to 1000
  173. c
  174. c  no convergence
  175. c
  176.   150 nogo=1
  177.       write (iofile,151)
  178.   151 format('1*error*:  no convergence in dc analysis'/'0last node vol'
  179.      1   ,'tages:'/)
  180.       write (iofile,avhdr) (anode,avltg,i=1,nvprln)
  181.       write (iofile,avfrm) (lprn,nodplc(junode+i),value(lvnim1+i),
  182.      1  i=2,ncnods)
  183.       go to 1000
  184. c
  185. c  ....  dc transfer curves
  186. c
  187.   300 numout=jelcnt(41)+1
  188.       if(ipostp.ne.0) call pheadr(atitle)
  189.       itemp=itcelm(1)
  190.       locs=nodplc(itemp+1)
  191.       anam=value(locs)
  192.       call move(anam,2,ablnk,1,7)
  193.       irdctc=0
  194.       irdct2=0
  195.       itdctc=0
  196.       itdct2=0
  197.       if (anam.eq.aletr) irdctc=1
  198.       if (anam.eq.alett) itdctc=1
  199.       temval=value(locs+1)
  200.       icvfl2=1
  201.       if(itcelm(2).eq.0) go to 310
  202.       itemp=itcelm(2)
  203.       locs2=nodplc(itemp+1)
  204.       anam=value(locs2)
  205.       call move(anam,2,ablnk,1,7)
  206.       if (anam.eq.aletr) irdct2=1
  207.       if (anam.eq.alett) itdct2=1
  208.       temv2=value(locs2+1)
  209.       value(locs2+1)=tcstar(2)
  210.       temp=dabs((tcstop(2)-tcstar(2))/tcincr(2))+0.5d0
  211.       icvfl2=idint(temp)+1
  212.       icvfl2=max0(icvfl2,1)
  213.   310 delta=tcincr(1)
  214.       do 320 i=1,7
  215.       delold(i)=delta
  216.   320 continue
  217.       icvfl1=icvflg/icvfl2
  218.       value(locs+1)=tcstar(1)
  219.       if ((itdctc.ne.1).and.(itdct2.ne.1)) go to 325
  220.       itemno=3
  221.       if (itdctc.eq.1) value(itemps+itemno)=value(locs+1)
  222.       if (itdct2.eq.1) value(itemps+itemno)=value(locs2+1)
  223.       call tmpupd
  224.   325 if (irdctc.eq.1) value(locs+1)=1.0d0/value(locs+1)
  225.       if (irdct2.eq.1) value(locs2+1)=1.0d0/value(locs2+1)
  226.       icalc=0
  227.       ical2=0
  228.       loctim=3
  229.   340 initf=2
  230.       call iter8(itl1)
  231.       rstats(4)=rstats(4)+iterno
  232.       call copy8(value(lx0+1),value(lx1+1),nxtrm)
  233.       if(nolx2.eq.0) call copy8(value(lx0+1),value(lx2+1),nxtrm)
  234.       if (igoof.ne.0) go to 450
  235.       go to 360
  236.   350 call getcje
  237.       if ((maxtim-itime).le.limtim) go to 460
  238.       initf=6
  239.       call iter8(itl2)
  240.       rstats(4)=rstats(4)+iterno
  241.       if (igoof.ne.0) go to 340
  242. c
  243. c  store outputs
  244. c
  245.   360 call extmem(loutpt,numout)
  246.       loco=loutpt+icalc*numout
  247.       icalc=icalc+1
  248.       ical2=ical2+1
  249.       value(loco+1)=value(locs+1)
  250.       if (irdctc.eq.1) value(loco+1)=1.0d0/value(loco+1)
  251.       loc=locate(41)
  252.   370 if (loc.eq.0) go to 400
  253.       if (nodplc(loc+5).ne.0) go to 380
  254.       node1=nodplc(loc+2)
  255.       node2=nodplc(loc+3)
  256.       iseq=nodplc(loc+4)
  257.       value(loco+iseq)=value(lvnim1+node1)-value(lvnim1+node2)
  258.       loc=nodplc(loc)
  259.       go to 370
  260.   380 iptr=nodplc(loc+2)
  261.       iptr=nodplc(iptr+6)
  262.       iseq=nodplc(loc+4)
  263.       value(loco+iseq)=value(lvnim1+iptr)
  264.       loc=nodplc(loc)
  265.       go to 370
  266. c
  267. c  increment source value
  268. c
  269.   400 if(ipostp.eq.0) go to 410
  270.       value(ibuff+1)=value(locs+1)
  271.       call copy8(value(lvnim1+2),value(ibuff+2),nunods-1)
  272.       if(numcur.ne.0) call copy8(value(lvnim1+loccur+1),
  273.      1  value(ibuff+nunods+1),numcur)
  274.       call fwrite(value(ibuff+1),numpos)
  275.   410 if (icalc.ge.icvflg) go to 490
  276.       if(ical2.ge.icvfl1) go to 480
  277.       if(nolx2.ne.0) go to 420
  278.       call ptrmem(lx2,itemp)
  279.       call ptrmem(lx1,lx2)
  280.       go to 430
  281.   420 call ptrmem(lx1,itemp)
  282.   430 call ptrmem(lx0,lx1)
  283.       call ptrmem(itemp,lx0)
  284.       value(locs+1)=tcstar(1)+dble(ical2)*delta
  285.       if (itdctc.ne.1) go to 440
  286.       value(itemps+itemno-1)=value(itemps+itemno)
  287.       value(itemps+itemno)=value(locs+1)
  288.       call tmpupd
  289.   440 if (irdctc.eq.1) value(locs+1)=1.0d0/value(locs+1)
  290.       go to 350
  291. c
  292. c  no convergence
  293. c
  294.   450 itemp=itcelm(1)
  295.       loce=nodplc(itemp+1)
  296.       write (iofile,451) value(loce),value(locs+1)
  297.   451 format('1*error*:  no convergence in dc transfer curves at ',a8,
  298.      1   ' = ',1pd10.3/'0last node voltages:'/)
  299.       write (iofile,avhdr) (anode,avltg,i=1,nvprln)
  300.       write (iofile,avfrm) (lprn,nodplc(junode+i),value(lvnim1+i),
  301.      1  i=2,ncnods)
  302.       go to 470
  303.   460 write (iofile,461)
  304.   461 format('0*error*:  cpu time limit exceeded ... analysis stopped'/)
  305.       go to 470
  306.   462 write(iofile,463)
  307.   463 format('0*error*:   temperature sweep should be the second sweep
  308.      1source, change the order and re-execute'/)
  309.   470 nogo=1
  310.       go to 490
  311. c... reset first sweep variable ... step second
  312.   480 ical2=0
  313.       value(locs+1)=tcstar(1)
  314.       if (irdctc.eq.1) value(locs+1)=1.0d0/value(locs+1)
  315.       if (itdctc.eq.1) go to 462
  316.       value(locs2+1)=value(locs2+1)+tcincr(2)
  317.       if (irdct2.eq.1) value(locs2+1)=1.0d0/value(locs2+1)
  318.       if (itdct2.ne.1) go to 340
  319.       value(itemps+itemno-1)=value(itemps+itemno)
  320.       value(itemps+itemno)=value(locs2+1)
  321.       call tmpupd
  322.       go to 340
  323. c
  324. c  finished with dc transfer curves
  325. c
  326.   490 value(locs+1)=temval
  327.       if(itcelm(2).ne.0) value(locs2+1)=temv2
  328.       if ((itdctc.eq.0).and.(itdct2.eq.0)) go to 1000
  329.       value(itemps+itemno-1)=value(itemps+itemno)
  330.       if (itdctc.eq.1) value(itemps+itemno)=temval
  331.       if (itdct2.eq.1) value(itemps+itemno)=temv2
  332.       write (iofile,492)
  333.   492 format (/,'0*****0 return to original temperature 0*****0',/)
  334.       call tmpupd
  335.       itemno=1
  336.       call relmem(itemps,2)
  337.       if(ipostp.eq.0) go to 1000
  338.       call fwrite(value(ibuff+1),numpos)
  339.       go to 1000
  340. c
  341. c  ....  transient analysis
  342. c
  343.   500 numout=jelcnt(42)+1
  344.       if(ipostp.ne.0) call pheadr(atitle)
  345. c...  limit delmax if no energy-storage elements
  346.       numese=jelcnt(2)+jelcnt(3)+jelcnt(11)+jelcnt(12)+jelcnt(13)
  347.      1   +jelcnt(14)
  348.       if (numese.eq.0) delmax=dmin1(delmax,tstep)
  349.       initf=5
  350.       iord=1
  351.       loctim=9
  352.       icalc=0
  353.       numtp=0
  354.       numrtp=0
  355.       numnit=0
  356.       time=0.0d0
  357.       ibkflg=1
  358.       delbkp=delmax
  359.       nbkpt=1
  360.       delta=delmax
  361.       do 510 i=1,7
  362.       delold(i)=delta
  363.   510 continue
  364.       delnew=delta
  365.       delmin=1.0d-9*delmax
  366.       go to 650
  367. c
  368. c  increment time, update sources, and solve next timepoint
  369. c
  370.   600 time=time+delta
  371.       call sorupd
  372.       if (nogo.ne.0) go to 950
  373.       call getcje
  374.       if ((maxtim-itime).le.limtim) go to 920
  375.       if ((itl5.ne.0).and.(numnit.ge.itl5)) go to 905
  376.       call comcof
  377.       if (initf.ne.5) initf=6
  378.       itrlim=itl4
  379.       if ((numtp.eq.0).and.(nosolv.ne.0)) itrlim=itl1
  380.       call iter8(itrlim)
  381.       numnit=numnit+iterno
  382.       numtp=numtp+1
  383.       if (numtp.ne.1) go to 605
  384.       if(nolx2.eq.0) call copy8(value(lx1+1),value(lx2+1),nxtrm)
  385.       if(nolx3.eq.0) call copy8(value(lx1+1),value(lx3+1),nxtrm)
  386. c.. note that time-point is cut when itrlim exceeded regardless
  387. c.. of which time-step contol is specified thru 'lvltim'.
  388.   605 if (igoof.eq.0) go to 610
  389.       jord=iord
  390.       iord=1
  391.       if (jord.ge.5) call clrmem(lx7)
  392.       if (jord.ge.4) call clrmem(lx6)
  393.       if (jord.ge.3) call clrmem(lx5)
  394.       if ((jord.ge.2).and.(method.ne.1)) call clrmem(lx4)
  395.       igoof=0
  396.       time=time-delta
  397.       delta=delta/8.0d0
  398.       go to 620
  399.   610 delnew=delta
  400.       if (numtp.eq.1) go to 630
  401.       call trunc(delnew)
  402.       if (delnew.ge.(0.9d0*delta)) go to 630
  403.       time=time-delta
  404.       delta=delnew
  405.   620 numrtp=numrtp+1
  406.       ibkflg=0
  407.       delold(1)=delta
  408.       if (delta.ge.delmin) go to 600
  409.       time=time+delta
  410.       go to 900
  411. c
  412. c  determine order of integration method
  413. c
  414. c...  skip if trapezoidal algorithm used
  415.   630 if ((method.eq.1).and.(iord.eq.2)) go to 650
  416.       if (numtp.eq.1) go to 650
  417.       ordrat=1.05d0
  418.       if (iord.gt.1) go to 635
  419.       iord=2
  420.       call trunc(delnew)
  421.       iord=1
  422.       if ((delnew/delta).le.ordrat) go to 650
  423.       if (maxord.le.1) go to 650
  424.       iord=2
  425.       if (method.eq.1) go to 650
  426.       call getm8(lx4,nxtrm)
  427.       go to 650
  428.   635 if (iord.lt.maxord) go to 640
  429.       iord=iord-1
  430.       call trunc(delnew)
  431.       iord=iord+1
  432.       if ((delnew/delta).le.ordrat) go to 650
  433.       go to 642
  434.   640 iord=iord-1
  435.       call trunc(delnew)
  436.       iord=iord+1
  437.       if ((delnew/delta).le.ordrat) go to 645
  438.   642 iord=iord-1
  439.       if (iord.eq.1) call clrmem(lx4)
  440.       if (iord.eq.2) call clrmem(lx5)
  441.       if (iord.eq.3) call clrmem(lx6)
  442.       if (iord.eq.4) call clrmem(lx7)
  443.       go to 650
  444.   645 iord=iord+1
  445.       call trunc(delnew)
  446.       iord=iord-1
  447.       if ((delnew/delta).le.ordrat) go to 650
  448.       iord=iord+1
  449.       if (iord.eq.2) call getm8(lx4,nxtrm)
  450.       if (iord.eq.3) call getm8(lx5,nxtrm)
  451.       if (iord.eq.4) call getm8(lx6,nxtrm)
  452.       if (iord.eq.5) call getm8(lx7,nxtrm)
  453. c
  454. c  store outputs
  455. c
  456.   650 if ((time+delta).le.tstart) go to 685
  457.       if ((numtp.eq.0).and.(nosolv.ne.0)) go to 685
  458.       call extmem(loutpt,numout)
  459.       loco=loutpt+icalc*numout
  460.       icalc=icalc+1
  461.       value(loco+1)=time
  462.       loc=locate(42)
  463.   670 if (loc.eq.0) go to 682
  464.       if (nodplc(loc+5).ne.0) go to 680
  465.       node1=nodplc(loc+2)
  466.       node2=nodplc(loc+3)
  467.       iseq=nodplc(loc+4)
  468.       value(loco+iseq)=value(lvnim1+node1)-value(lvnim1+node2)
  469.       loc=nodplc(loc)
  470.       go to 670
  471.   680 iptr=nodplc(loc+2)
  472.       iptr=nodplc(iptr+6)
  473.       iseq=nodplc(loc+4)
  474.       value(loco+iseq)=value(lvnim1+iptr)
  475.       loc=nodplc(loc)
  476.       go to 670
  477.   682 if(ipostp.eq.0) go to 684
  478.       value(ibuff+1)=time
  479.       call copy8(value(lvnim1+2),value(ibuff+2),nunods-1)
  480.       if(numcur.ne.0) call copy8(value(lvnim1+loccur+1),
  481.      1  value(ibuff+nunods+1),numcur)
  482.       call fwrite(value(ibuff+1),numpos)
  483.   684 continue
  484. c
  485. c  update transmission line delay table
  486. c
  487.   685 if (jelcnt(17).eq.0) go to 694
  488.       call sizmem(ltd,ltdsiz)
  489.       numtd=ltdsiz/ntlin
  490.       if (numtd.le.3) go to 689
  491.       baktim=time-tdmax
  492.       if (baktim.lt.0.0d0) go to 689
  493.       lcntr=0
  494.       ltemp=ltd
  495.       do 686 i=1,numtd
  496.       if (value(ltemp+1).ge.baktim) go to 687
  497.       ltemp=ltemp+ntlin
  498.       lcntr=lcntr+1
  499.   686 continue
  500.       go to 689
  501.   687 if (lcntr.le.2) go to 689
  502.       lcntr=lcntr-2
  503.       nwords=lcntr*ntlin
  504.       ltemp=ltemp-ntlin-ntlin
  505.       call copy8(value(ltemp+1),value(ltd+1),ltdsiz-nwords)
  506.       call relmem(ltd,nwords)
  507.       call sizmem(ltd,ltdsiz)
  508.   689 call extmem(ltd,ntlin)
  509.       ltdptr=ltd+ltdsiz
  510.       value(ltdptr+1)=time
  511.       loc=locate(17)
  512.   690 if (loc.eq.0) go to 693
  513.       locv=nodplc(loc+1)
  514.       z0=value(locv+1)
  515.       node1=nodplc(loc+2)
  516.       node2=nodplc(loc+3)
  517.       node3=nodplc(loc+4)
  518.       node4=nodplc(loc+5)
  519.       ibr1=nodplc(loc+8)
  520.       ibr2=nodplc(loc+9)
  521.       lspot=nodplc(loc+30)+ltdptr
  522.       if ((initf.eq.5).and.(nosolv.ne.0)) go to 691
  523.       value(lspot)=value(lvnim1+node3)-value(lvnim1+node4)
  524.      1   +value(lvnim1+ibr2)*z0
  525.       value(lspot+1)=value(lvnim1+node1)-value(lvnim1+node2)
  526.      1   +value(lvnim1+ibr1)*z0
  527.       go to 692
  528.   691 value(lspot)=value(locv+7)+value(locv+8)*z0
  529.       value(lspot+1)=value(locv+5)+value(locv+6)*z0
  530.   692 loc=nodplc(loc)
  531.       go to 690
  532. c
  533. c  add two *fake* backpoints to ltd for interpolation near time=0.0d0
  534. c
  535.   693 if (numtd.ne.0) go to 694
  536.       call extmem(ltd,ntlin+ntlin)
  537.       call copy8(value(ltd+1),value(ltd+ntlin+1),ntlin)
  538.       call copy8(value(ltd+1),value(ltd+2*ntlin+1),ntlin)
  539.       value(ltd+2*ntlin+1)=time
  540.       value(ltd+ntlin+1)=time-delta
  541.       value(ltd+1)=time-delta-delta
  542. c
  543. c  rotate state vector storage
  544. c
  545. c.. time-point accepted
  546.   694 call copy8(delold(1),delold(2),6)
  547.       delta=delnew
  548.       delold(1)=delta
  549.       go to (710,706,702,698,696,696), iord
  550.   696 call ptrmem(lx7,itemp)
  551.       call ptrmem(lx6,lx7)
  552.       go to 700
  553.   698 call ptrmem(lx6,itemp)
  554.   700 call ptrmem(lx5,lx6)
  555.       go to 704
  556.   702 call ptrmem(lx5,itemp)
  557.   704 call ptrmem(lx4,lx5)
  558.       go to 708
  559.   706 if (method.eq.1) go to 710
  560.       call ptrmem(lx4,itemp)
  561.   708 call ptrmem(lx3,lx4)
  562.       go to 713
  563.   710 if(nolx3.eq.0) go to 712
  564.       if(nolx2.eq.0) go to 711
  565.       call ptrmem(lx1,itemp)
  566.       go to 714
  567.   711 call ptrmem(lx2,itemp)
  568.       call ptrmem(lx1,lx2)
  569.       go to 714
  570.   712 call ptrmem(lx3,itemp)
  571.   713 call ptrmem(lx2,lx3)
  572.       call ptrmem(lx1,lx2)
  573.   714 call ptrmem(lx0,lx1)
  574.       call ptrmem(itemp,lx0)
  575. c
  576. c  check breakpoints
  577. c
  578.   750 if (ibkflg.eq.0) go to 760
  579. c.. just accepted analysis at breakpoint
  580.       jord=iord
  581.       iord=1
  582.       if (jord.ge.5) call clrmem(lx7)
  583.       if (jord.ge.4) call clrmem(lx6)
  584.       if (jord.ge.3) call clrmem(lx5)
  585.       if ((jord.ge.2).and.(method.ne.1)) call clrmem(lx4)
  586.       ibkflg=0
  587.       nbkpt=nbkpt+1
  588.       if (nbkpt.gt.numbkp) go to 950
  589.       temp=dmin1(delbkp,value(lsbkpt+nbkpt)-time)
  590.       delta=dmin1(delta,0.1d0*temp,delmax)
  591.       if (numtp.eq.0) delta=delta/10.0d0
  592.       delold(1)=delta
  593.       go to 600
  594.   760 del1=value(lsbkpt+nbkpt)-time
  595.       if ((1.01d0*delta).le.del1) go to 600
  596.       ibkflg=1
  597.       delbkp=delta
  598.       delta=del1
  599.       delold(1)=delta
  600.       go to 600
  601. c
  602. c  transient analysis failed
  603. c
  604.   900 write (iofile,901)
  605.   901 format('1*error*:  internal timestep too small in transient analys
  606.      1is'/)
  607.       go to 910
  608.   905 write (iofile,906) itl5
  609.   906 format('1*error*:  transient analysis iterations exceed limit of '
  610.      1,i5,/'0this limit may be overridden using the itl5 parameter on th
  611.      2e .option card')
  612.   910 write (iofile,911) time,delta,numnit
  613.   911 format(1h0,10x,'time = ',1pd12.5,';  delta = ',d12.5,';  numnit =
  614.      1',i6/)
  615.       write (iofile,916)
  616.   916 format(1h0/'0last node voltages:'/)
  617.       write (iofile,avhdr) (anode,avltg,i=1,nvprln)
  618.       write (iofile,avfrm) (lprn,nodplc(junode+i),value(lvnim1+i),
  619.      1  i=2,ncnods)
  620.       go to 930
  621.   920 write (iofile,921) time
  622.   921 format('0*error*:  cpu time limit exceeded in transient analysis '
  623.      1   ,'at time = ',1pd13.6/)
  624.   930 nogo=1
  625. c
  626. c  finished with transient analysis
  627. c
  628.   950 rstats(10)=rstats(10)+numnit
  629.       rstats(30)=rstats(30)+numtp
  630.       rstats(31)=rstats(31)+numrtp
  631.       rstats(32)=rstats(32)+numnit
  632.       if(ipostp.eq.0) go to 1000
  633.       if (ipostp.ne.0) call clsraw
  634. c
  635. c  return unneeded memory
  636. c
  637.  1000 if (mode.eq.2) go to 1010
  638.       if (modedc.ne.3) go to 1100
  639.  1010 call clrmem(lvnim1)
  640.       call clrmem(lx0)
  641.       call clrmem(lvn)
  642.       call clrmem(lx1)
  643.       if (memptr(macins)) call clrmem(macins)
  644.       if(nolx2.eq.0) call clrmem(lx2)
  645.       call clrmem(lvntmp)
  646.       if ((mode.eq.1).and.(modedc.eq.3)) go to 1020
  647.       if(nolx3.eq.0) call clrmem(lx3)
  648.       if (mode.eq.1) go to 1020
  649.       call clrmem(ltd)
  650.       if (iord.eq.1) go to 1020
  651.       if (method.eq.1) go to 1020
  652.       call clrmem(lx4)
  653.       if (iord.eq.2) go to 1020
  654.       call clrmem(lx5)
  655.       if (iord.eq.3) go to 1020
  656.       call clrmem(lx6)
  657.       if (iord.eq.4) go to 1020
  658.       call clrmem(lx7)
  659.  1020 call extmem(loutpt,2*numout)
  660.  1100 if(ipostp.ne.0) call clrmem(ibuff)
  661.       call second(t2)
  662.       rstats(loctim)=rstats(loctim)+t2-t1
  663.       return
  664.       end
  665.